home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / white.arc / DRAW02.4TH < prev    next >
Encoding:
Text File  |  1986-11-07  |  4.0 KB  |  158 lines
  1. \ LPS LPC READ-PEN -- light pen utilities             04Mar84RSW
  2.         FORTH DEFINITIONS HEX
  3. : TASK ;
  4. 3D4 CONSTANT CRTAD 3D5 CONSTANT CRTD  10 CONSTANT LPADH
  5. 11 CONSTANT LPADL  3DA CONSTANT LPS   3DB CONSTANT LPC
  6. 2 CONSTANT LPMASK  4 CONSTANT LPSMASK   DECIMAL
  7.  
  8. : READ-PEN  ( --- pen-address )
  9.    LPS P@ LPMASK AND 2 = IF             \ pen lit?
  10.      LPADH CRTAD P! CRTD P@ 256 *       \  yes - read hi addr
  11.      LPADL CRTAD P! CRTD P@             \        read lo addr
  12.      OR                                 \      combine addresses
  13.    ELSE
  14.      0                                  \  no - return 0
  15.    THEN
  16.    0 LPC P! ;                   \ clear pen status
  17. \  DSP-LP-SW -- display light pen switch status       04Mar84RSW
  18.  
  19.  
  20. : DSP-LP-SW
  21.         LPS P@ LPSMASK AND 4 = IF       \ fetch switch status
  22.           ."   open     "
  23.         ELSE
  24.           ."   closed   "
  25.         THEN
  26.         ;
  27.  
  28.  
  29.  
  30.  
  31.  
  32.  
  33. \  MON-PEN -- monitor light pen status                04Mar84RSW
  34.  
  35.  
  36. : MON-PEN
  37.    CR
  38.    BEGIN
  39.       READ-PEN
  40.       HEX U. DECIMAL DSP-LP-SW 13 EMIT
  41.       ?TERMINAL
  42.    UNTIL
  43.    CR ." DONE " ;
  44.  
  45.  
  46.  
  47.  
  48.  
  49.  
  50.  
  51.  
  52.  
  53.  
  54.  
  55.  
  56. NSTANT     LIT.ADR
  57. ' :            2 - @ CONSTANT   DOCOL.ADR
  58. ' 0BRANCH      2 - CONSTANT     0BRANCH.ADR
  59. ' BRANCH       2 - CONSTANT     BRANCH.ADR
  60. ' <+LOOP>      2 - CONSTANT     PLOOP.ADR
  61. ' <.">         2 - CONSTANT     PDOTQ.ADR
  62. ' C/L          2 - @ CONSTANT   CONST.ADR
  63. ' BASE         2 - @ CONSTANT   USERV.ADR
  64. ' USE          2 - @ CONSTANT   VAR.ADR
  65. ' <;CODE>      2 - CONSTANT     PSCODE.ADR
  66.  
  67. \ constants cont -- fig-FORTH Decompiler              30Dec83RSW
  68.  
  69. ' </LOOP>      2 - CONSTANT     SLOOP.ADR
  70. ' <ABORT">     2 - CONSTANT     PABORTQ.ADR
  71. ' EXIT         2 - CONSTANT     EXIT.ADR
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83. \ N. PDOTQ.DSP WORD.DSP -- fig-FORTH Decompiler       30Dec83RSW
  84.         FORTH DEFINITIONS DECIMAL
  85. : N.            ( print a number in decimal and hex )
  86.                 DUP DECIMAL . SPACE
  87.                 HEX 0 ." ( " D. ." H ) "   DECIMAL ;
  88.  
  89. : PDOTQ.DSP     ( display a compiled text string )
  90.                 WORD.PTR @ 2+ DUP >R DUP
  91.                 C@ + 1 - WORD.PTR !
  92.                 R> COUNT TYPE ;
  93.  
  94. : WORD.DSP      ( given CFA, display the glossary name )
  95.                 3 - -1 TRAVERSE DUP 1+ C@ 59 =
  96.                 IF 1 QUIT.FLAG ! THEN
  97.                 DUP C@ 160 AND 128 =
  98.                 IF ID. ELSE 1 QUIT.FLAG ! THEN  ;
  99. \ BRANCH.DSP USERV.DSP -- fig-FORTH Decompiler        30Dec83RSW
  100.  
  101. : BRANCH.DSP    ( get branch offset, calculate the )
  102.                 ( actual branch address, and display it )
  103.                 ." to "
  104.                 WORD.PTR @ 2+ DUP WORD.PTR !
  105.                 DUP @ +
  106.                 0 HEX D. DECIMAL              ;
  107.  
  108. : USERV.DSP     ( display a user variable )
  109.                 ." User variable, current value = "
  110.                 WORD.PTR @ 2+
  111.                 C@ [ HEX ] 38 UP @ + + [ DECIMAL ]
  112.                @ N.
  113.                 1 QUIT.FLAG !  ;
  114.  
  115. \ VAR.DSP CONST.DSP -- fig-FORTH Decompiler           30Dec83RSW
  116.  
  117. : VAR.DSP       ( display a variable )
  118.                 ." Variable, current value = "
  119.                 WORD.PTR @ 2+
  120.                 @ N.
  121.                 1 QUIT.FLAG ! ;
  122.  
  123. : CONST.DSP     ( display a compiled constant )
  124.                 ." Constant, value = "
  125.                 WORD.PTR @ 2+
  126.                 @ N.
  127.                 1 QUIT.FLAG !   ;
  128.  
  129.  
  130.  
  131. \ DIS -- fig-FORTH Decompiler                         29Dec83RSW
  132. : DIS
  133.   -FIND 0=
  134.   IF 3 SPACES ." ? not in glossary " CR
  135.   ELSE DROP DUP DUP 2 -
  136.   @ =
  137.   IF ." <primitive> " CR
  138.   ELSE
  139.   0 QUIT.FLAG !
  140.   2 - WORD.PTR !
  141.   CR CR
  142.   BEGIN
  143.   WORD.PTR @ DUP
  144.   0 HEX D. SPACE DECIMAL
  145.   @
  146. -->
  147. \ DIS cont -- fig-FORTH Decompiler                    30Dec83RSW
  148. CASE
  149. LIT.ADR OF
  150.                 WORD.PTR @ 2+ DUP WORD.PTR ! @ N. ENDOF
  151. DOCOL.ADR OF
  152.                 ." : "  ENDOF
  153. 0BRANCH.ADR OF
  154.                 ." Branch if zero "   BRANCH.DSP ENDOF
  155. BRANCH.ADR OF
  156.                 ." Branch "   BRANCH.DSP ENDOF
  157. LOOP.ADR OF
  158.                 ." Loop "     BRANCH.D